import Data.Monoid
import Control.Monad
-- import Control.Arrow

data Parser = Literal String | Range Char Char | Or Parser Parser | 
	Concat Parser Parser | ZeroOrMore Parser | NOrLess Int Parser
	deriving (Eq, Ord, Show, Read)

instance Monoid Parser where
	mempty = Literal ""
	mappend = Concat

orNothing :: Bool -> a -> Maybe a
orNothing predicate value = if predicate then Just value else Nothing

parse :: Parser -> String -> Maybe (String, String)

parse (Literal value) text = 
	orNothing (before == value) (value, after) 
	where (before, after) = splitAt (length value) text 

parse (Range low high) text =
	case text of
		[] -> Nothing
		(firstChar:rest) -> orNothing (low <= firstChar && firstChar <= high) ([firstChar], rest)

parse (Or a b) text = parse a text `mplus` parse b text

parse (Concat a b) text = do
	(x, rest) <- parse a text
	(y, rest2) <- parse b rest
	return (x ++ y, rest2)

parse z@(ZeroOrMore p) text =
	case parse p text of
		Nothing -> Just ("", text)
		Just (x, rest) -> case parse z rest of
			Nothing -> error "should not happen"
			Just (y, rest2) -> Just (x ++ y, rest2)

parse (NOrLess 0 p) text = Just ("", text)
parse (NOrLess n p) text = 
	case parse p text of
		Nothing -> Just ("", text)
		Just (x, rest) -> 
			case parse (NOrLess (n-1) p) rest of
				Nothing -> error "should not happen"
				Just (y, rest2) -> Just (x ++ y, rest2)	

optional :: Parser -> Parser
optional = NOrLess 1 

fixedCount :: Int -> Parser -> Parser
fixedCount n p = mconcat (replicate n p)

nOrMore :: Int -> Parser -> Parser
nOrMore n p = fixedCount n p `mappend` ZeroOrMore p 

oneOrMore :: Parser -> Parser
oneOrMore = nOrMore 1

rangedCount :: Int -> Int -> Parser -> Parser
rangedCount low high p = fixedCount low p `mappend` NOrLess (high - low) p

anychar = Range minBound maxBound

first_char = ('a' `Range` 'z') `Or` ('A' `Range` 'Z') `Or` Literal "_"
rest_of_word = ('a' `Range` 'z') `Or` ('A' `Range` 'Z') `Or` 
	('0' `Range` '9') `Or` Literal "_" 
word = mconcat [first_char, oneOrMore rest_of_word]

main :: IO ()
main = do
 	print $ parse word "Hello!"








































